create or replace package body m4o_package_generator as

  C_MODULE constant m4o_module := new m4o_module('m4o_package_generator');

  -- ===========================================================================

  type package_part_type_lookup_tt is table of number index by varchar2(30);

  subtype source_lines_t is m4osys_dynsql.lines_t;

  -- ===========================================================================
  p_type_ids_lookup  package_part_type_lookup_tt;

  p_in_m4o_package_part  boolean := false;

  -- ===========================================================================
  C_APPLY_BEFORE_SPEC      constant varchar2(30) := 'APPLY_BEFORE_SPEC';
  C_APPLY_BEFORE_BODY      constant varchar2(30) := 'APPLY_BEFORE_BODY';
  C_APPLY_BEFORE_SPEC_PART constant varchar2(30) := 'APPLY_BEFORE_SPEC_PART';
  C_APPLY_BEFORE_BODY_PART constant varchar2(30) := 'APPLY_BEFORE_BODY_PART';
  -- ===========================================================================
  function trim_ws(i_str in varchar2) return varchar2
  is
  begin
    return m4o_v2.trim_ws(regexp_replace(i_str,'^NoThInG',null));
  end;
  -- ===========================================================================
  procedure apply_advices(i_when in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('apply_advices',
                                       m4o_v2tab(i_when));
    v_advice_procs m4o_v2tab;
    v_code         varchar2(4000);
    v_part_ix      pls_integer;
    procedure set_code(
      i_spec_proc in varchar2,
      i_body_proc in varchar2,
      i_code      in varchar2)
    is
    begin
      case
      when i_when='spec' and i_spec_proc member of v_advice_procs then
        v_code := replace(i_code,':0',i_spec_proc);
      when i_when='body' and i_body_proc member of v_advice_procs then
        v_code := replace(i_code,':0',i_body_proc);
      else
        v_code := null;
      end case;
    end;
  begin
    v_pc.do('Find pointcuts and advices for m4o_package_defn');
    for v_advice in (select p.name         p_name,
                            a.name         a_name,
                            a.owner,
                            a.package_name
                     from m4o_pointcut_advice pa,
                          m4o_pointcut        p,
                          m4o_advice          a
                     where pa.pointcut_id  = p.id
                     and   pa.advice_id    = a.id
                     and   regexp_like(p_package.in_schema,p.owner_rx)
                     and   regexp_like(p_package.name     ,p.name_rx)
                     order by pa.position  desc) loop
      v_pc.do('Applying advice "'||
              v_advice.a_name||
              '" at pointcut "'||
              v_advice.p_name||
              '"');

      v_pc.do('Loading available procs of advice package');
      select procedure_name
      bulk collect into v_advice_procs
      from all_procedures
      where owner          = v_advice.owner
      and   object_name    = v_advice.package_name
      and   procedure_name in (C_APPLY_BEFORE_SPEC,
                               C_APPLY_BEFORE_SPEC_PART,
                               C_APPLY_BEFORE_BODY,
                               C_APPLY_BEFORE_BODY_PART);

      set_code(
        i_spec_proc => C_APPLY_BEFORE_SPEC,
        i_body_proc => C_APPLY_BEFORE_BODY,
        i_code      =>
          'begin'||chr(10)||
          '  '||v_advice.owner||'.' ||v_advice.package_name||'.:0('||
          'i_package => m4o_package_generator.p_package);'||
          chr(10)||
          'end;');
      if v_code is null then
        v_pc.log('no package code in advice package');
      else
        v_pc.do(v_code);
        execute immediate v_code;
      end if;

      set_code(
        i_spec_proc => C_APPLY_BEFORE_SPEC_PART,
        i_body_proc => C_APPLY_BEFORE_BODY_PART,
        i_code      =>
          'begin'||chr(10)||
          '  '||v_advice.owner||'.'||v_advice.package_name||'.:0('||
          'i_part => m4o_package_generator.p_package.parts(:1));'||
          chr(10)||
          'end;');

      if v_code is null then
        v_pc.log('no part code in advice package');
      else
        v_part_ix := p_package.parts.first;
        while v_part_ix is not null loop

          p_part_id := v_part_ix;
          v_pc.do(replace(v_code,':1',v_part_ix));
          execute immediate v_code using v_part_ix;

          v_part_ix := p_package.parts.next(v_part_ix);
        end loop;
        p_part_id := null;
      end if;
    end loop;
  end;
  -- ===========================================================================
  procedure w_part_start(
    i_part      in out nocopy part_t,
    i_final_str in varchar2 := null)
  is
  begin
    m4o_code_generator.w(
      '  '||
      case i_part.type_id
      when C_FUNCTION_TYPEID  then 'function'
      when C_PROCEDURE_TYPEID then 'procedure'
      end||
      ' '||
      i_part.name||
      case nvl(length(i_part.arguments),0)
      when 0 then null
      else '('             ||
           chr(10)         ||
           '    '          ||
           i_part.arguments||
           ')'
      end||
      case i_part.type_id
      when C_FUNCTION_TYPEID then
        chr(10)||
        '  return '||i_part.return_type
      end||
      i_final_str);
  end;
  -- ===========================================================================
  procedure generate_spec
  is
    v_pc m4o_context := C_MODULE.proc('generate_spec');
    v_declaration_id number;
    v_ix             pls_integer;
  begin
    v_declaration_id := p_type_ids_lookup('declaration');

    m4o_code_generator.init;

    m4o_code_generator.w(
      'create or replace package '||
      p_package.in_schema||
      '.'||
      p_package.name||
      case
      when p_package.authid_current_user='Y' then
        ' authid current_user '
      else
        ' '
      end||
      'as');

    v_ix := p_package.parts.first;
    while v_ix is not null loop
      if p_package.parts(v_ix).type_id   = C_DECLARATION_TYPEID 
         and p_package.parts(v_ix).is_public = 'Y' then
        m4o_code_generator.w('--m4o part #'||v_ix);
        m4o_code_generator.w(p_package.parts(v_ix).sourcecode);
      end if;
      v_ix := p_package.parts.next(v_ix);
    end loop;

    v_ix := p_package.parts.first;
    while v_ix is not null loop
      if p_package.parts(v_ix).type_id in (C_PROCEDURE_TYPEID,
                                           C_FUNCTION_TYPEID) 
          and p_package.parts(v_ix).is_public = 'Y' then
        m4o_code_generator.w('--m4o part #'||v_ix);
        w_part_start(
          i_part      => p_package.parts(v_ix),
          i_final_str => ';');
      end if;
      v_ix := p_package.parts.next(v_ix);
    end loop;

    m4o_code_generator.w('end;');
  end;
  -- ===========================================================================
  procedure generate_body
  is
    v_pc m4o_context := C_MODULE.proc('generate_body',
                                       m4o_v2tab('<package_t>'));
    v_ix             pls_integer;
  begin
    m4o_code_generator.init;
    m4o_code_generator.w(
      'create or replace package body '||
      p_package.in_schema||
      '.'||
      p_package.name||
      ' as');

    v_ix := p_package.parts.first;
    while v_ix is not null loop
      if p_package.parts(v_ix).type_id   = C_DECLARATION_TYPEID 
         and p_package.parts(v_ix).is_public = 'N' then
          m4o_code_generator.w('--m4o part #'||v_ix||':'||p_package.parts(v_ix).name);
          m4o_dbg.p('sourcecode@'||v_ix||':'||p_package.parts(v_ix).name||'='||
                    p_package.parts(v_ix).sourcecode);
          m4o_code_generator.w(p_package.parts(v_ix).sourcecode);
      end if;
      v_ix := p_package.parts.next(v_ix);
    end loop;

    v_ix := p_package.parts.first;
    while v_ix is not null loop
      if p_package.parts(v_ix).type_id in (C_PROCEDURE_TYPEID,
                                           C_FUNCTION_TYPEID) then
        m4o_code_generator.w('--m4o part #'||v_ix);
        w_part_start(i_part => p_package.parts(v_ix));
        m4o_code_generator.w('  is'||
                             case
                             when p_package.parts(v_ix).local_declarations 
                                  is not null
                             then
                             chr(10)||
                             '    ' ||p_package.parts(v_ix).local_declarations
                             end);
        m4o_code_generator.w('  begin');
        m4o_code_generator.w(p_package.parts(v_ix).sourcecode);
        m4o_code_generator.w('  end;');
      end if;
      v_ix := p_package.parts.next(v_ix);
    end loop;

    v_ix := p_package.parts.first;
    while v_ix is not null loop
      if p_package.parts(v_ix).type_id = C_INIT_TYPEID then
        m4o_code_generator.w('--m4o part #'||v_ix);
        m4o_code_generator.w('begin');
        if p_package.parts(v_ix).local_declarations is not null then
          m4o_code_generator.w('  declare');
          m4o_code_generator.w('    '||
                               p_package.parts(v_ix).local_declarations);
        end if;
        m4o_code_generator.w('  begin');
        m4o_code_generator.w(p_package.parts(v_ix).sourcecode);
        m4o_code_generator.w('  end;');
      end if;
      v_ix := p_package.parts.next(v_ix);
    end loop;

    m4o_code_generator.w('end;');
  end;
  -- ===========================================================================
  procedure package_begin(
    i_schema_and_name           in varchar2,
    i_authid_current_user       in varchar2,
    i_current_schema            in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('package_begin',
                                       m4o_v2tab(i_schema_and_name,
                                       i_authid_current_user));
    v_schema_and_name varchar2(90):= upper(trim_ws(i_schema_and_name));
    v_dotpos number               := instr(v_schema_and_name,'.');
    v_empty  package_t;
  begin
    p_package := v_empty;

    if v_dotpos > 0 then
      p_package.in_schema         := substr(v_schema_and_name,1,v_dotpos-1);
      p_package.name              := substr(v_schema_and_name,v_dotpos+1);
    else
      p_package.in_schema         := i_current_schema;
      p_package.name              := v_schema_and_name;
    end if;

    p_package.authid_current_user := i_authid_current_user;
  end;
  -- ===========================================================================
  procedure store_metadata
  is
    v_pc m4o_context             := C_MODULE.proc('store_metadata');
    v_package_id number;
    v_part_id    number;
    v_package    m4o_package_defn%rowtype;
    -- -------------------------------------------------------------------------
    procedure insert_attributes(
      i_part_pos   in number,
      i_attributes in out nocopy attribute_tt)
    is
      v_attr m4o_package_attr.name%type;
    begin
      v_pc.do('... attributes:');
      if i_attributes.count > 0 then
        v_attr := i_attributes.first;
        while v_attr is not null loop
          v_pc.do('... @+ '||v_attr);
          insert into m4o_package_attr (
            id,
            package_id,
            part_pos,
            name,
            value
          ) values (
            m4o_seq.nextval,
            v_package.id,
            i_part_pos,
            v_attr,
            i_attributes(v_attr)
          );
          v_attr := i_attributes.next(v_attr);
        end loop;
      end if;
    end;
    -- -------------------------------------------------------------------------
  begin
    v_pc.do('Delete old m4o_package_defn');
    delete from m4o_package_defn
    where name               = p_package.name
    and   nvl(in_schema,'*') = nvl(p_package.in_schema,'*');
    v_pc.log_rowcount;

    select m4o_seq.nextval
    into v_package.id
    from dual;

    v_package.name                := p_package.name;
    v_package.in_schema           := p_package.in_schema;
    v_package.authid_current_user := p_package.authid_current_user;

    v_pc.do('Insert m4o_package_defn '||p_package.in_schema||'.'||p_package.name);
    insert into m4o_package_defn values v_package;

    insert_attributes(
      i_part_pos   => null,
      i_attributes => p_package.attributes);

    for i in 1 .. p_package.parts.count loop
      if p_package.parts.exists(i) then
        v_pc.do('Insert part #'||i||' ('||p_package.parts(i).name||')');
        insert into m4o_package_part (
          id,
          package_id,
          pos,
          is_public,
          type_id,
          sourcecode,
          name,
          return_type,
          arguments,
          local_declarations
        ) values (
          m4o_seq.nextval,
          v_package.id,
          i,
          p_package.parts(i).is_public,
          p_package.parts(i).type_id,
          p_package.parts(i).sourcecode,
          p_package.parts(i).name,
          p_package.parts(i).return_type,
          p_package.parts(i).arguments,
          p_package.parts(i).local_declarations
        );

        insert_attributes(
          i_part_pos   => i,
          i_attributes => p_package.parts(i).attributes);
      end if;
    end loop;
  end;
  -- ===========================================================================
  procedure load_parsed_arguments
  is
    v_pc m4o_context := C_MODULE.proc('load_parsed_arguments');
    type proc_args_tt is table of argument_tt index by varchar2(80);
    v_proc_args       proc_args_tt;
    v_prev_part_name  varchar2(4000);
    v_overload        number;
    -- -------------------------------------------------------------------------
    -- initialize v_proc_args
    procedure compute_all_args_for_package
    is
      v_oid     number;
      v_prev_ix varchar2(80);
      v_args    argument_tt;
      v_arg     argument_t;
    begin
      v_pc.do('Get object_id of package '||
              p_package.in_schema||
              '.'||
              p_package.name);
      select object_id
      into   v_oid
      from dba_objects
      where object_name = p_package.name
      and   owner       = p_package.in_schema
      and   object_type = 'PACKAGE';

      v_pc.log('object_id='||v_oid);

      for i in (select nvl(overload,1)||object_name ix,
                       argument_name,
                       data_type
                from dba_arguments
                where object_id  = v_oid
                and   position   > 0
                and   data_level = 0
                and   data_type  is not null
                order by object_name,
                         nvl(overload,1),
                         sequence) loop
        v_pc.log(i.ix||' '||i.argument_name||' '||i.data_type);
        if v_prev_ix <> i.ix then
          v_proc_args(v_prev_ix) := v_args;
          v_args.delete;
        end if;
        v_prev_ix              := i.ix;
        v_arg.name             := i.argument_name;
        v_arg.data_type        := i.data_type;
        v_args(v_args.count+1) := v_arg;
      end loop;
      if v_prev_ix is not null then 
        v_proc_args(v_prev_ix) := v_args;
      end if;
    exception
      when OTHERS then
        v_pc.error('compute_all_args_for_package: '||
                   sqlerrm);
    end;
    -- -------------------------------------------------------------------------
    function get_arguments_for_proc(
      i_name     in varchar2,
      i_overload in number
    ) return argument_tt
    is
      v_args argument_tt;
    begin
      return v_proc_args(nvl(i_overload,1)||upper(i_name));
    exception
    when NO_DATA_FOUND then return v_args;
    end;
    -- -------------------------------------------------------------------------
  begin
    compute_all_args_for_package;

    for i in p_package.parts.first .. p_package.parts.last loop
      if p_package.parts.exists(i) 
         and p_package.parts(i).is_public='Y' then
        v_pc.do('Part#'||i);
        if nvl(v_prev_part_name,'<null>') = p_package.parts(i).name then
          v_overload := v_overload + 1;
        else
          v_prev_part_name := p_package.parts(i).name;
          v_overload        := 1;
        end if;

        p_package.parts(i).parsed_arguments := 
          get_arguments_for_proc(
            i_name     => p_package.parts(i).name,
            i_overload => v_overload);
      end if;
    end loop;
  end;
  -- ===========================================================================
  procedure package_end
  is
    v_pc m4o_context             := C_MODULE.proc('package_end');
    v_empty   package_t;
  begin
    if p_package.attributes.exists('authid')
       and upper(p_package.attributes('authid'))='CURRENT_USER' then
      p_package.authid_current_user := 'Y';
    end if;

    store_metadata;

    apply_advices(i_when => 'spec');
    generate_spec;
    m4o_code_generator.execute_code_if_different(
      i_owner    => p_package.in_schema,
      i_type     => 'PACKAGE',
      i_name     => p_package.name);

    load_parsed_arguments;

    apply_advices(i_when => 'body');
    generate_body;
    m4o_code_generator.execute_code_if_different(
      i_owner    => p_package.in_schema,
      i_type     => 'PACKAGE BODY',
      i_name     => p_package.name);

    v_pc.do('Reset p_package');
    p_package                     := v_empty;
  end;
  -- ===========================================================================
  procedure set_attr(
    i_name                      in varchar2,
    i_value                     in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('set_attr',
                                       m4o_v2tab(i_name,
                                             i_value));
    v_name  varchar2(4000);
    v_value varchar2(4000);
  begin
    v_name  := trim_ws(i_name);
    v_value := trim_ws(i_value);
    if p_package.parts.count = 0 then
      p_package.attributes(v_name) := v_value;
    else
      p_package.parts(p_package.parts.last).attributes(v_name) := v_value;
    end if;
  end;
  -- ===========================================================================
  procedure package_part_begin(
    i_type_name                 in varchar2,
    i_name_and_visibility       in varchar2 := null,
    i_return_type               in varchar2 := null,
    i_arguments                 in varchar2 := null)
  is
    v_pc m4o_context := C_MODULE.proc('package_part_begin',
                                       m4o_v2tab(i_type_name,
                                             i_name_and_visibility,
                                             i_return_type,
                                             i_arguments));
    v_part part_t;
    v_name varchar2(90)           := trim_ws(i_name_and_visibility);
  begin
    p_in_m4o_package_part  := true;

    v_part.name        := rtrim(v_name,' *');
    v_part.is_public   := case
                            when v_name like '%*' then 'Y'
                            else 'N'
                          end;
    begin
      v_part.type_id   := p_type_ids_lookup(i_type_name);
    exception
    when NO_DATA_FOUND then
      v_pc.error('Invalid package part type "'||
                 i_type_name||
                 '"');
    end;

    v_part.return_type := trim_ws(i_return_type);
    v_part.arguments   := trim_ws(i_arguments);

    p_package.parts(p_package.parts.count+1) := v_part;
  end;
  -- ===========================================================================
  function current_part return number
  is
    v_pc m4o_context := C_MODULE.proc('current_part');
  begin
    if p_package.parts.count = 0 then
      v_pc.error('Package has no parts');
    end if;

    return p_package.parts.count;
  end;
  -- ===========================================================================
  procedure set_local_declarations(
    i_local_declarations        in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('set_local_declarations',
                                       m4o_v2tab(i_local_declarations));
  begin
    if not p_in_m4o_package_part then
      package_part_begin(
        i_type_name           => 'init',
        i_name_and_visibility => null);
    end if;

    p_package.parts(current_part).local_declarations := trim_ws(
                                                          i_local_declarations);
  end;
  -- ===========================================================================
  procedure set_sourcecode(
    i_sourcecode                in varchar2)
  is
    v_pc m4o_context := C_MODULE.proc('set_sourcecode',
                                       m4o_v2tab(i_sourcecode));
  begin
    if not p_in_m4o_package_part then
      package_part_begin(
        i_type_name           => 'init',
        i_name_and_visibility => null);
    end if;

    p_package.parts(current_part).sourcecode     := 
      ltrim(rtrim(i_sourcecode,chr(10)||' '),chr(10));
  end;
  -- ===========================================================================
  procedure package_part_end
  is
  begin
    p_in_m4o_package_part := false;
  end;

  -- ===========================================================================
  -- helper for aspect code: return if attribute i_name exists for current part
  -- or at package level
  function attribute_exists(
    i_name                      in varchar2)
  return boolean
  is
  begin
    return (p_package.parts.exists(p_part_id)
            and p_package.parts(p_part_id).attributes.exists(i_name))
           or p_package.attributes.exists(i_name);
  end;
  -- ===========================================================================
  function get_attribute(
    i_name                      in varchar2)
  return varchar2
  is
    function get_pkg_attribute return varchar2
    is
    begin
      return p_package.attributes(i_name);
    exception when NO_DATA_FOUND then return null;
    end;
  begin
      return case
               when p_package.parts.exists(p_part_id) then
                 p_package.parts(p_part_id).attributes(i_name)
               else get_pkg_attribute
             end;
  exception
  when NO_DATA_FOUND then return get_pkg_attribute;
  end;
  -- ===========================================================================
begin
  for i in (select * from m4o_package_part_type order by codegen_order) loop
    p_type_ids_lookup(i.name)      := i.id;
  end loop;
end;
/
